perm filename TRANSF.F4[IRC,LCS]1 blob
sn#641771 filedate 1982-02-15 generic text, type T, neo UTF8
00100 C READS IN TWO FILES FOR TRANSFORMATION
00200 IMPLICIT INTEGER (X-Z)
00300 DIMENSION RN(3)
00400 C RN WILL HOLD FILE NAMES
00500 COMMON /A/X1(800),Y1(800),Z1(800),K1
00600 COMMON /B/X2(800),Y2(800),Z2(800),K2
00700 COMMON /C/X3(800),Y3(800),Z3(800),K3
00800 COMMON /D/X4(800),Y4(800),Z4(800),K4
00900 CALL READX(1)
01000 CALL READX(2)
01100 C IF(K1.LT.K2)GO TO 1
01200 C CALL REVERS
01300 C1 CALL EQUALO
01400 C ASSUMES OUTLINE IS FIRST LONG CONTINUOUS LINE.
01500 C FIRST EQUALIZES OUTLINE, THEN THE REST
01600 C CALL EQUALZ
01700 CALL EQUAL
01800 2 CALL PRCNTQ
01900 CALL OUTPUT
02100 100 END
02200
02300 SUBROUTINE EQUAL
02400 COMMON /A/X1(800),Y1(800),Z1(800),K1
02500 COMMON /D/X4(800),Y4(800),Z4(800),K4
02600 COMMON /B/X2(800),Y2(800),Z2(800),K2
02700 COMMON /C/X3(800),Y3(800),Z3(800),K3
02800 L=1
02900 K=1
03000 M=0
03100 4 I=K
03200 J=L
03300 CALL SEG(Z1,K,K1,NN1)
03400 CALL SEG(Z2,L,K2,NN2)
03500 A=NN1
03600 B=NN2
03700 IF(NN1.GT.NN2)GO TO 1
03800 C=A/B
03900 D=I
04000 2 DO 3 KK=J,L
04100 M=M+1
04200 N=D
04300 X4(M)=X2(KK)
04400 Y4(M)=Y2(KK)
04500 C Z4(M)=Z2(KK)
04600 X3(M)=X1(N)
04700 Y3(M)=Y1(N)
04800 Z3(M)=Z2(KK)
04900 3 D=D+C
05000 6 K=K+1
05100 L=L+1
05200 IF(K.LT.K1)GO TO 4
05300 K3=M
05400 RETURN
05500 1 C=B/A
05600 D=J
05700 DO 5 KK=I,K
05800 M=M+1
05900 N=D
06000 X3(M)=X1(KK)
06100 Y3(M)=Y1(KK)
06200 Z3(M)=Z1(KK)
06300 X4(M)=X2(N)
06400 Y4(M)=Y2(N)
06500 C Z4(M)=Z2(KK)
06600 5 D=D+C
06700 GO TO 6
06800 END
06900
07000 SUBROUTINE SEG(Z,K,K1,NN)
07100 DIMENSION Z(1)
07200 DO 1 N=K+1,K1
07300 1 IF(Z(N).NE.0)GO TO 2
07400 N=K1+1
07500 2 NN=N-K
07550 K=N-1
07600 END
07700
07800 SUBROUTINE PRCNTQ
07900 IMPLICIT INTEGER (X-Z)
08000 COMMON /A/X1(800),Y1(800),Z1(800),K1
08100 COMMON /B/X2(800),Y2(800),Z2(800),K2
08200 COMMON /C/X3(800),Y3(800),Z3(800),K3
08300 COMMON /D/X4(800),Y4(800),Z4(800),K4
08400 10 FORMAT(' TYPE PERCENT OF TRANSFORMATION (.5=50%) '$)
08500 11 FORMAT(F)
08600 TYPE 10
08700 ACCEPT 11,P
08800 DO 1 K=1,K3
08900 A=X4(K)-X3(K)
09000 A=A*P+.5
09100 B=Y4(K)-Y3(K)
09200 B=B*P+.5
09300 X3(K)=X3(K)+A
09400 1 Y3(K)=Y3(K)+B
09500 END